W raporcie dokonano analizy czterech zbiorów danych. Pierwszy z nich zawiera 213 wskaźników opisujących rozwój gospodarczy poszczególnych krajów i całego świata w latach 1970-2020, przy czym analizie poddano jedynie dane dotyczące rozwoju ogólnoświatowego. Pozostałe zbiory zawierają kolejno ceny złota, kursy wymiany walut i miesięczne wyniki S&P Composite. Celem analizy było zbadanie, które zmienne są skorelowane z cenami złota i zbudowanie na ich podstawie regresora dokonującego predykcji cen złota.
Ze wskaźników rozwoju gospodarczego najwyższą wartość współczynnika korelacji Pearsona z cenami złota osiągnęła emisja gazów cieplarnianych, w przypadku kursów wymiany walut był to kurs dolara brunejskiego, a ze zbioru S&P Composite dywidenda. Cena złota w kolejnych latach wykazywała tendencję wzrostową, więc najbardziej skorelowane z nią były te zmienne, które również wykazywały monotoniczność względem czasu. Kurs dolara brunejskiego malał z czasem, natomiast pozostałe z wymienionych zmiennych rosły.
Do wytrenowania regresora wykorzystano ceny złota wraz ze zmiennymi, dla których wartość bezwzględna współczynnika korelacji z nimi wyniosła co najmniej 0,85. Użyto w tym celu algorytmu Random Forest. Wytrenowano go na zbiorze treningowym z wykorzystaniem 3-krotnej walidacji krzyżowej powtórzonej 5 razy. Następnie przetestowano na zbiorze testowym, osiągając następujące wartości miar:
RMSE = 14.9532186
Rsquared = 0.9990274
MAE = 8.9470331
Po dokonaniu analizy ważności atrybutów okazało się, że największy wpływ na predykcję ceny złota miały następujące zmienne:
Kurs chińskiego Yuana
Wydatki krajowe brutto
Emisja gazów cieplarnianych
Produkcja energii elektrycznej ze źródeł odnawialnych z wyłączeniem hydroelektrowni
library(dplyr)
library(tidyr)
library(readxl)
library(corrplot)
library(caret)
library(zoo)
library(plotly)
Dane dotyczące statystyk rozwoju gospodarczego poszczególnych krajów wczytano za pomocą poniższego kodu.
world_dev_ind <- read_excel("Data pack/World_Development_Indicators.xlsx", sheet = "Data", na = "..")
head(world_dev_ind)
## # A tibble: 6 x 55
## `Country Name` `Country Code` `Series Name` `Series Code` `1970 [YR1970]`
## <chr> <chr> <chr> <chr> <dbl>
## 1 Afghanistan AFG Urban population ~ SP.URB.GROW 5.75
## 2 Afghanistan AFG Urban population ~ SP.URB.TOTL.~ 11.6
## 3 Afghanistan AFG Value lost due to~ IC.FRM.OUTG.~ NA
## 4 Afghanistan AFG Urban population SP.URB.TOTL 1300949
## 5 Afghanistan AFG Urban land area (~ AG.LND.TOTL.~ NA
## 6 Afghanistan AFG Unemployment, tot~ SL.UEM.TOTL.~ NA
## # ... with 50 more variables: 1971 [YR1971] <dbl>, 1972 [YR1972] <dbl>,
## # 1973 [YR1973] <dbl>, 1974 [YR1974] <dbl>, 1975 [YR1975] <dbl>,
## # 1976 [YR1976] <dbl>, 1977 [YR1977] <dbl>, 1978 [YR1978] <dbl>,
## # 1979 [YR1979] <dbl>, 1980 [YR1980] <dbl>, 1981 [YR1981] <dbl>,
## # 1982 [YR1982] <dbl>, 1983 [YR1983] <dbl>, 1984 [YR1984] <dbl>,
## # 1985 [YR1985] <dbl>, 1986 [YR1986] <dbl>, 1987 [YR1987] <dbl>,
## # 1988 [YR1988] <dbl>, 1989 [YR1989] <dbl>, 1990 [YR1990] <dbl>, ...
Do analizy użyto jedynie wskaźników opisujących rozwój całego świata bez podziału na kraje (dane z wartością “World” kolumny “Country Name”), ponieważ prawdopodobnie rozwój ogólnoświatowy ma większy wpływ na ceny złota niż rozwój pojedynczego kraju. Dane przetworzono do postaci, w której każdy wiersz zawiera rok i wartości poszczególnych wskaźników w osobnych kolumnach. Nazwy kolumn pochodzą z kolumny “Series Code” oryginalnego zbioru. Taki format danych jest przydatny do obliczania korelacji między poszczególnymi zmiennymi. Zbiór ograniczono jedynie do tych kolumn, które są wypełnione danymi przynajmniej w 70%. Listę tych kolumn zawiera zmienna filled_series w poniższym kodzie. Wartości z mniej wypełnionych kolumn mogłyby być niereprezentatywne w przypadku szukania korelacji.
world_dev_ind <- world_dev_ind %>%
filter(`Country Name` == "World") %>%
select(-c("Country Name", "Country Code")) %>%
gather("Year", "Value", -c("Series Name", "Series Code")) %>%
mutate(Year = substr(Year, 1, 4), `Series Name` = gsub("\\$", " dollar", `Series Name`))
filled_series <- world_dev_ind %>%
group_by(`Series Code`) %>%
summarise(not_na_values = sum(!is.na(Value))) %>%
filter(not_na_values > 35) %>%
select(`Series Code`)
world_dev_ind_spread <- world_dev_ind %>%
filter(`Series Code` %in% filled_series$`Series Code`) %>%
select(-c("Series Name")) %>%
spread("Series Code", "Value")
head(world_dev_ind_spread)
## # A tibble: 6 x 93
## Year AG.LND.TOTL.K2 BG.GSR.NFSV.GD.ZS BM.GSR.MRCH.CD BM.GSR.NFSV.CD
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 1970 129856730. NA NA NA
## 2 1971 129856720. NA NA NA
## 3 1972 129856620. NA NA NA
## 4 1973 129856550. NA NA NA
## 5 1974 129856080. NA NA NA
## 6 1975 129855560. 5.97 NA NA
## # ... with 88 more variables: BX.GSR.MRCH.CD <dbl>, BX.GSR.NFSV.CD <dbl>,
## # BX.PEF.TOTL.CD.WD <dbl>, CM.MKT.TRAD.CD <dbl>, CM.MKT.TRAD.GD.ZS <dbl>,
## # DT.ODA.ODAT.CD <dbl>, EG.ELC.COAL.ZS <dbl>, EG.ELC.FOSL.ZS <dbl>,
## # EG.ELC.HYRO.ZS <dbl>, EG.ELC.NGAS.ZS <dbl>, EG.ELC.NUCL.ZS <dbl>,
## # EG.ELC.RNWX.KH <dbl>, EG.ELC.RNWX.ZS <dbl>, EN.ATM.CO2E.EG.ZS <dbl>,
## # EN.ATM.CO2E.GF.KT <dbl>, EN.ATM.CO2E.GF.ZS <dbl>, EN.ATM.CO2E.KD.GD <dbl>,
## # EN.ATM.CO2E.KT <dbl>, EN.ATM.CO2E.LF.KT <dbl>, EN.ATM.CO2E.LF.ZS <dbl>, ...
Ze zbioru dotyczącego cen złota wczytano datę, miesiąc i rok pomiaru w celu powiązania tych danych z danymi z innych zbiorów, które mierzone są z różną ziarnistością. Z kolumn zawierających wartości złota wybrano tą przechowującą ceny w dolarach mierzone przed południem.
gold_prices <- read.csv("Data pack/Gold prices.csv")
gold_prices$Date <- as.Date(gold_prices$Date)
gold_prices <- gold_prices %>%
mutate(Year = format(Date, format="%Y"),
Month = format(Date, format="%Y-%m"),
Price_USD_AM = `USD..AM.`) %>%
select(Date, Year, Month, Price_USD_AM)
head(gold_prices)
## Date Year Month Price_USD_AM
## 1 2021-09-29 2021 2021-09 1741.65
## 2 2021-09-28 2021 2021-09 1739.65
## 3 2021-09-27 2021 2021-09 1749.15
## 4 2021-09-24 2021 2021-09 1755.15
## 5 2021-09-23 2021 2021-09 1771.05
## 6 2021-09-22 2021 2021-09 1775.35
Poniższy kod odpowiada za wczytanie zbioru przechowującego kursy wymiany walut. Podobnie jak w przypadku World Development Indicators zachowano tylko kolumny wypełnione w przynajmniej 70%.
curr_ex_rates <- read.csv("Data pack/CurrencyExchangeRates.csv")
curr_ex_rates$Date <- as.Date(curr_ex_rates$Date)
filled_curr_columns <- curr_ex_rates %>%
gather("Currency", "Rate", -c("Date")) %>%
group_by(`Currency`) %>%
summarise(not_na_values = sum(!is.na(Rate))) %>%
filter(not_na_values > 4184) %>%
select(`Currency`)
curr_ex_rates <- curr_ex_rates %>%
select(Date, as.vector(filled_curr_columns$Currency))
Poniższy kod odpowiada za wczytanie zbioru S&P Composite. Zawiera on dane od roku 1871, jednak ograniczono go do wartości od 1968 roku, ponieważ będą one wykorzystywane do szukania relacji z cenami złota, które są dostępne właśnie od roku 1968. Wartości te są mierzone raz w miesiącu, więc z daty zachowano tylko miesiąc. Wywołanie funkcji summary pokazuje, że kolumny tego zbioru są prawie całkowicie wypełnione wartościami.
sp_composite <- read.csv("Data pack/S&P Composite.csv")
sp_composite$Year <- as.Date(sp_composite$Year)
sp_composite <- sp_composite %>%
filter(Year >= as.Date("1968-01-01")) %>%
mutate(Month = format(Year, format="%Y-%m")) %>%
select(-"Year")
summary(sp_composite)
## S.P.Composite Dividend Earnings CPI
## Min. : 67.07 Min. : 2.930 Min. : 5.13 Min. : 34.10
## 1st Qu.: 122.53 1st Qu.: 6.362 1st Qu.: 13.77 1st Qu.: 90.85
## Median : 469.27 Median :12.967 Median : 24.46 Median :149.70
## Mean : 888.30 Mean :17.622 Mean : 41.03 Mean :147.31
## 3rd Qu.:1318.06 3rd Qu.:23.715 3rd Qu.: 65.98 3rd Qu.:212.07
## Max. :4493.28 Max. :59.680 Max. :158.74 Max. :273.98
## NA's :4 NA's :4
## Long.Interest.Rate Real.Price Real.Dividend Real.Earnings
## Min. : 0.620 Min. : 306.3 Min. :18.02 Min. : 8.805
## 1st Qu.: 3.757 1st Qu.: 598.0 1st Qu.:20.35 1st Qu.: 41.878
## Median : 6.110 Median : 872.2 Median :24.13 Median : 49.831
## Mean : 6.140 Mean :1289.3 Mean :28.43 Mean : 64.852
## 3rd Qu.: 7.893 3rd Qu.:1772.0 3rd Qu.:30.84 3rd Qu.: 87.762
## Max. :15.320 Max. :4477.2 Max. :63.51 Max. :159.504
## NA's :4 NA's :4
## Cyclically.Adjusted.PE.Ratio Month
## Min. : 6.639 Length:646
## 1st Qu.:13.920 Class :character
## Median :20.499 Mode :character
## Mean :20.775
## 3rd Qu.:26.386
## Max. :44.198
##
head(sp_composite)
## S.P.Composite Dividend Earnings CPI Long.Interest.Rate Real.Price
## 1 3700.650 NA NA 260.1097 0.93 3700.650
## 2 4493.280 NA NA 273.9832 1.29 4477.204
## 3 4454.206 NA NA 273.6565 1.28 4443.570
## 4 4363.713 NA NA 273.0030 1.32 4363.713
## 5 4238.490 57.86504 158.74 271.6960 1.52 4258.879
## 6 4167.850 57.78782 148.56 269.1950 1.62 4226.807
## Real.Dividend Real.Earnings Cyclically.Adjusted.PE.Ratio Month
## 1 NA NA 33.73946 2021-10
## 2 NA NA 38.34228 2021-09
## 3 NA NA 38.09043 2021-08
## 4 NA NA 37.44349 2021-07
## 5 58.14340 159.5036 36.69631 2021-06
## 6 58.60528 150.6615 36.55215 2021-05
Poniżej przedstawiono podstawowe statystyki atrybutów i rozmiary wstępnie przetworzonych zbiorów danych.
Liczba wierszy: 51
Liczba kolumn: 93
Liczba wierszy: 13585
Liczba kolumn: 4
| Date | Year | Month | Price_USD_AM | |
|---|---|---|---|---|
| Min. :1968-01-02 | Length:13585 | Length:13585 | Min. : 34.77 | |
| 1st Qu.:1981-06-10 | Class :character | Class :character | 1st Qu.: 280.50 | |
| Median :1994-11-14 | Mode :character | Mode :character | Median : 383.32 | |
| Mean :1994-11-16 | Mean : 575.20 | |||
| 3rd Qu.:2008-04-23 | 3rd Qu.: 841.94 | |||
| Max. :2021-09-29 | Max. :2061.50 | |||
| NA’s :1 |
Liczba wierszy: 5978
Liczba kolumn: 40
| Date | Australian.Dollar | Bahrain.Dinar | Botswana.Pula | Brazilian.Real | Brunei.Dollar | Canadian.Dollar | Chilean.Peso | |
|---|---|---|---|---|---|---|---|---|
| Min. :1995-01-02 | Min. :0.4833 | Min. :0.376 | Min. :0.0855 | Min. :0.832 | Min. :1.000 | Min. :0.917 | Min. :377.5 | |
| 1st Qu.:2000-10-05 | 1st Qu.:0.6654 | 1st Qu.:0.376 | 1st Qu.:0.1197 | 1st Qu.:1.709 | 1st Qu.:1.348 | 1st Qu.:1.086 | 1st Qu.:503.5 | |
| Median :2006-07-06 | Median :0.7595 | Median :0.376 | Median :0.1528 | Median :2.048 | Median :1.468 | Median :1.297 | Median :538.6 | |
| Mean :2006-07-27 | Mean :0.7683 | Mean :0.376 | Mean :0.1965 | Mean :2.161 | Mean :1.508 | Mean :1.268 | Mean :561.8 | |
| 3rd Qu.:2012-05-07 | 3rd Qu.:0.8689 | 3rd Qu.:0.376 | 3rd Qu.:0.1844 | 3rd Qu.:2.794 | 3rd Qu.:1.698 | 3rd Qu.:1.409 | 3rd Qu.:619.8 | |
| Max. :2018-05-02 | Max. :1.1055 | Max. :0.376 | Max. :4.8414 | Max. :4.195 | Max. :1.851 | Max. :1.613 | Max. :758.2 | |
| NA’s :263 | NA’s :69 | NA’s :1275 | NA’s :539 | NA’s :1246 | NA’s :356 | NA’s :1220 |
| Chinese.Yuan | Colombian.Peso | Danish.Krone | Euro | Hungarian.Forint | Icelandic.Krona | Indian.Rupee | Indonesian.Rupiah | |
|---|---|---|---|---|---|---|---|---|
| Min. :6.093 | Min. : 833.2 | Min. :4.665 | Min. :0.8252 | Min. :144.1 | Min. : 54.72 | Min. :31.37 | Min. : 2201 | |
| 1st Qu.:6.495 | 1st Qu.:1786.0 | 1st Qu.:5.612 | 1st Qu.:1.0889 | 1st Qu.:202.7 | 1st Qu.: 70.28 | 1st Qu.:42.82 | 1st Qu.: 8855 | |
| Median :6.989 | Median :2017.6 | Median :6.051 | Median :1.2295 | Median :224.3 | Median : 83.48 | Median :45.92 | Median : 9260 | |
| Mean :7.316 | Mean :2073.1 | Mean :6.281 | Mean :1.2076 | Mean :231.1 | Mean : 92.46 | Mean :48.02 | Mean : 9144 | |
| 3rd Qu.:8.277 | 3rd Qu.:2482.9 | 3rd Qu.:6.805 | 3rd Qu.:1.3338 | 3rd Qu.:267.6 | 3rd Qu.:117.15 | 3rd Qu.:52.33 | 3rd Qu.:11380 | |
| Max. :8.746 | Max. :3434.9 | Max. :9.006 | Max. :1.5990 | Max. :318.7 | Max. :147.98 | Max. :68.78 | Max. :14850 | |
| NA’s :1316 | NA’s :582 | NA’s :251 | NA’s :1070 | NA’s :1415 | NA’s :354 | NA’s :429 | NA’s :1492 |
| Iranian.Rial | Japanese.Yen | Korean.Won | Kuwaiti.Dinar | Libyan.Dinar | Malaysian.Ringgit | Nepalese.Rupee | New.Zealand.Dollar | |
|---|---|---|---|---|---|---|---|---|
| Min. : 1699 | Min. : 75.86 | Min. : 756 | Min. :0.2646 | Min. :0.525 | Min. :2.436 | Min. : 49.88 | Min. :0.3927 | |
| 1st Qu.: 1755 | 1st Qu.:100.70 | 1st Qu.:1013 | 1st Qu.:0.2854 | 1st Qu.:0.662 | 1st Qu.:3.188 | 1st Qu.: 68.33 | 1st Qu.:0.5813 | |
| Median : 8992 | Median :109.39 | Median :1122 | Median :0.2947 | Median :1.932 | Median :3.676 | Median : 74.04 | Median :0.6844 | |
| Mean :10718 | Mean :107.97 | Mean :1100 | Mean :0.2936 | Mean :1.510 | Mean :3.508 | Mean : 77.37 | Mean :0.6606 | |
| 3rd Qu.:11180 | 3rd Qu.:118.38 | 3rd Qu.:1186 | 3rd Qu.:0.3027 | 3rd Qu.:1.932 | 3rd Qu.:3.800 | 3rd Qu.: 86.80 | 3rd Qu.:0.7364 | |
| Max. :42000 | Max. :147.00 | Max. :1965 | Max. :0.3089 | Max. :1.932 | Max. :4.725 | Max. :109.98 | Max. :0.8822 | |
| NA’s :1312 | NA’s :316 | NA’s :601 | NA’s :1054 | NA’s :123 | NA’s :301 | NA’s :479 | NA’s :310 |
| Norwegian.Krone | Pakistani.Rupee | Polish.Zloty | Qatar.Riyal | Rial.Omani | Saudi.Arabian.Riyal | Singapore.Dollar | South.African.Rand | |
|---|---|---|---|---|---|---|---|---|
| Min. :4.959 | Min. : 30.88 | Min. :2.022 | Min. :3.64 | Min. :0.3845 | Min. :3.745 | Min. :1.201 | Min. : 3.530 | |
| 1st Qu.:6.104 | 1st Qu.: 51.79 | 1st Qu.:3.033 | 1st Qu.:3.64 | 1st Qu.:0.3845 | 1st Qu.:3.745 | 1st Qu.:1.361 | 1st Qu.: 6.213 | |
| Median :6.709 | Median : 60.75 | Median :3.290 | Median :3.64 | Median :0.3845 | Median :3.750 | Median :1.444 | Median : 7.480 | |
| Mean :6.965 | Mean : 70.24 | Mean :3.365 | Mean :3.64 | Mean :0.3845 | Mean :3.749 | Mean :1.503 | Mean : 8.113 | |
| 3rd Qu.:7.806 | 3rd Qu.: 94.29 | 3rd Qu.:3.822 | 3rd Qu.:3.64 | 3rd Qu.:0.3845 | 3rd Qu.:3.750 | 3rd Qu.:1.687 | 3rd Qu.: 9.995 | |
| Max. :9.606 | Max. :115.70 | Max. :4.500 | Max. :3.64 | Max. :0.3845 | Max. :3.750 | Max. :1.851 | Max. :16.771 | |
| NA’s :291 | NA’s :488 | NA’s :1765 | NA’s :47 | NA’s :56 | NA’s :46 | NA’s :259 | NA’s :535 |
| Sri.Lanka.Rupee | Swedish.Krona | Swiss.Franc | Thai.Baht | Trinidad.And.Tobago.Dollar | U.A.E..Dirham | U.K..Pound.Sterling | U.S..Dollar | |
|---|---|---|---|---|---|---|---|---|
| Min. : 49.57 | Min. : 5.843 | Min. :0.7253 | Min. :24.44 | Min. :5.839 | Min. :3.671 | Min. :1.213 | Min. :1 | |
| 1st Qu.: 77.54 | 1st Qu.: 6.838 | 1st Qu.:0.9777 | 1st Qu.:31.50 | 1st Qu.:6.260 | 1st Qu.:3.672 | 1st Qu.:1.519 | 1st Qu.:1 | |
| Median :103.99 | Median : 7.618 | Median :1.1878 | Median :34.65 | Median :6.282 | Median :3.672 | Median :1.599 | Median :1 | |
| Mean :102.19 | Mean : 7.741 | Mean :1.2090 | Mean :35.14 | Mean :6.310 | Mean :3.672 | Mean :1.615 | Mean :1 | |
| 3rd Qu.:126.29 | 3rd Qu.: 8.384 | 3rd Qu.:1.3903 | 3rd Qu.:39.45 | 3rd Qu.:6.382 | 3rd Qu.:3.672 | 3rd Qu.:1.676 | 3rd Qu.:1 | |
| Max. :157.65 | Max. :10.995 | Max. :1.8228 | Max. :56.06 | Max. :6.789 | Max. :3.675 | Max. :2.102 | Max. :1 | |
| NA’s :509 | NA’s :349 | NA’s :239 | NA’s :565 | NA’s :657 | NA’s :71 | NA’s :122 |
Liczba wierszy: 646
Liczba kolumn: 10
| S.P.Composite | Dividend | Earnings | CPI | Long.Interest.Rate | |
|---|---|---|---|---|---|
| Min. : 67.07 | Min. : 2.930 | Min. : 5.13 | Min. : 34.10 | Min. : 0.620 | |
| 1st Qu.: 122.53 | 1st Qu.: 6.362 | 1st Qu.: 13.77 | 1st Qu.: 90.85 | 1st Qu.: 3.757 | |
| Median : 469.27 | Median :12.967 | Median : 24.46 | Median :149.70 | Median : 6.110 | |
| Mean : 888.30 | Mean :17.622 | Mean : 41.03 | Mean :147.31 | Mean : 6.140 | |
| 3rd Qu.:1318.06 | 3rd Qu.:23.715 | 3rd Qu.: 65.98 | 3rd Qu.:212.07 | 3rd Qu.: 7.893 | |
| Max. :4493.28 | Max. :59.680 | Max. :158.74 | Max. :273.98 | Max. :15.320 | |
| NA’s :4 | NA’s :4 |
| Real.Price | Real.Dividend | Real.Earnings | Cyclically.Adjusted.PE.Ratio | Month | |
|---|---|---|---|---|---|
| Min. : 306.3 | Min. :18.02 | Min. : 8.805 | Min. : 6.639 | Length:646 | |
| 1st Qu.: 598.0 | 1st Qu.:20.35 | 1st Qu.: 41.878 | 1st Qu.:13.920 | Class :character | |
| Median : 872.2 | Median :24.13 | Median : 49.831 | Median :20.499 | Mode :character | |
| Mean :1289.3 | Mean :28.43 | Mean : 64.852 | Mean :20.775 | ||
| 3rd Qu.:1772.0 | 3rd Qu.:30.84 | 3rd Qu.: 87.762 | 3rd Qu.:26.386 | ||
| Max. :4477.2 | Max. :63.51 | Max. :159.504 | Max. :44.198 | ||
| NA’s :4 | NA’s :4 |
W sekcji tej zbadano korelacje między cenami złota a pozostałymi zmiennymi. Celem tych operacji było znalezienie zmiennych najbardziej powiązanych z cenami złota, w celu wykorzystania ich do przewidywania jego wartości.
Aby znaleźć najbardziej skorelowane z cenami złota wskaźniki światowego rozwoju najpierw do ceny złota dołączono informację o wartości wskaźników w danym roku. Następnie obliczono współczynnik korelacji Pearsona między wszystkimi parami zmiennych, wykorzystując do obliczeń jedynie niepuste pary wartości zmiennych. Do dalszej analizy wykorzystane zostaną wskaźniki o współczynniku korelacji z cenami złota większym niż 0,85. Poniżej pokazano kody i nazwy tych zmiennych wraz z wartością współczynnika korelacji.
gold_and_wdi <- world_dev_ind_spread %>% full_join(gold_prices, by = "Year")
corr_gold_wdi <- gold_and_wdi %>% select(-c("Year", "Date", "Month")) %>% cor(use="pairwise.complete.obs")
corr_gold_wdi_list <- corr_gold_wdi["Price_USD_AM", ]
corr_gold_wdi_list <- corr_gold_wdi_list[names(corr_gold_wdi_list) %in% "Price_USD_AM" == FALSE]
gold_wdi_most_correlated <- names(corr_gold_wdi_list[abs(corr_gold_wdi_list) > 0.85])
print(knitr::kable(
world_dev_ind %>%
select("Series Name", "Series Code") %>%
filter(`Series Code` %in% gold_wdi_most_correlated) %>%
distinct() %>%
mutate(Corr=corr_gold_wdi_list[`Series Code`]) %>%
arrange(desc(abs(Corr)))))
| Series Name | Series Code | Corr |
|---|---|---|
| Total greenhouse gas emissions (kt of CO2 equivalent) | EN.ATM.GHGT.KT.CE | 0.9238080 |
| Net official development assistance received (current US dollar) | DT.ODA.ODAT.CD | 0.9164778 |
| Gross domestic savings (current US dollar) | NY.GDS.TOTL.CD | 0.9149618 |
| Exports of goods and services (current US dollar) | NE.EXP.GNFS.CD | 0.9149222 |
| Imports of goods and services (current US dollar) | NE.IMP.GNFS.CD | 0.9130048 |
| CO2 emissions from solid fuel consumption (kt) | EN.ATM.CO2E.SF.KT | 0.9104675 |
| CO2 emissions (kt) | EN.ATM.CO2E.KT | 0.9087731 |
| GDP (current US dollar) | NY.GDP.MKTP.CD | 0.9068064 |
| Gross national expenditure (current US dollar) | NE.DAB.TOTL.CD | 0.9031428 |
| Goods imports (BoP, current US dollar) | BM.GSR.MRCH.CD | 0.8968652 |
| Goods exports (BoP, current US dollar) | BX.GSR.MRCH.CD | 0.8916816 |
| GDP per capita (current US dollar) | NY.GDP.PCAP.CD | 0.8915023 |
| Service exports (BoP, current US dollar) | BX.GSR.NFSV.CD | 0.8900177 |
| Service imports (BoP, current US dollar) | BM.GSR.NFSV.CD | 0.8875640 |
| Electricity production from renewable sources, excluding hydroelectric (% of total) | EG.ELC.RNWX.ZS | 0.8784015 |
| Electricity production from renewable sources, excluding hydroelectric (kWh) | EG.ELC.RNWX.KH | 0.8756685 |
| Population ages 65 and above (% of total population) | SP.POP.65UP.TO.ZS | 0.8665449 |
| Trademark applications, direct resident | IP.TMK.RESD | 0.8528836 |
| Urban population | SP.URB.TOTL | 0.8525871 |
Korelacje z pozostałymi zmiennymi zbadano w analogiczny sposób.
Poniższe wykresy prezentują korelacje wartości złota z kursami wymiany poszczególnych walut. W tabeli pokazano kursy o największej wartości bezwzględnej współczynnika korelacji.
gold_and_curr <- curr_ex_rates %>% full_join(gold_prices, by = "Date")
corr_gold_curr <- gold_and_curr %>% select(-c("Year", "Date", "Month")) %>% cor(use="pairwise.complete.obs")
corr_gold_curr_list <- corr_gold_curr["Price_USD_AM", ]
corr_gold_curr_list <- corr_gold_curr_list[names(corr_gold_curr_list) %in% "Price_USD_AM" == FALSE]
gold_curr_most_correlated <- names(corr_gold_curr_list[abs(corr_gold_curr_list) > 0.85 & !is.na(corr_gold_curr_list)])
for(i in c(1, 21)) {
corrplot(corr_gold_curr["Price_USD_AM", i:(i+19), drop = FALSE], method="square", addCoef.col = 'black',
cl.pos = 'n', col = COL2('PiYG'))
}
print(knitr::kable(data.frame(Variable=gold_curr_most_correlated, Corr=as.vector(corr_gold_curr_list[gold_curr_most_correlated]))))
| Variable | Corr |
|---|---|
| Brunei.Dollar | -0.9602216 |
| Chinese.Yuan | -0.9464071 |
| Pakistani.Rupee | 0.8722006 |
| Swiss.Franc | -0.8736273 |
Poniższa tabela przedstawia najbardziej skorelowane z cenami złota zmienne ze zbioru S&P Composite.
gold_and_sp <- sp_composite %>% full_join(gold_prices, by = "Month")
corr_gold_sp <- gold_and_sp %>% select(-c("Year", "Date", "Month")) %>% cor(use="pairwise.complete.obs")
corr_gold_sp_list <- corr_gold_sp["Price_USD_AM", ]
corr_gold_sp_list <- corr_gold_sp_list[names(corr_gold_sp_list) %in% "Price_USD_AM" == FALSE]
gold_sp_most_correlated <- names(corr_gold_sp_list[abs(corr_gold_sp_list) > 0.85])
print(knitr::kable(data.frame(Variable=gold_sp_most_correlated, Corr=as.vector(corr_gold_sp_list[gold_sp_most_correlated]))))
| Variable | Corr |
|---|---|
| Dividend | 0.8750987 |
| Earnings | 0.8594710 |
print(knitr::kable(summary(gold_prices[, "Price_USD_AM", drop=FALSE])))
| Price_USD_AM | |
|---|---|
| Min. : 34.77 | |
| 1st Qu.: 280.50 | |
| Median : 383.32 | |
| Mean : 575.20 | |
| 3rd Qu.: 841.94 | |
| Max. :2061.50 | |
| NA’s :1 |
p <- ggplot(gold_prices, aes(Date, Price_USD_AM)) +
ggtitle("Gold Price") +
geom_line()
ggplotly(p)
Powyższy wykres pokazuje wzrost ceny złota od około 30 dolarów w roku 1968 do wartości w okolicach 2000 dolarów w roku 2020. Najbardziej znaczący wzrost tej ceny widać w latach 2001-2011, w których wzrosła ona z 250 do 1900 dolarów. Wartość maksymalną 2061,50 dolarów osiągnęła 07.08.2020 po czym rozpoczęła się tendencja spadkowa.
print(knitr::kable(summary(world_dev_ind_spread[, "EN.ATM.GHGT.KT.CE", drop=FALSE])))
| EN.ATM.GHGT.KT.CE | |
|---|---|
| Min. :25652776 | |
| 1st Qu.:30839910 | |
| Median :32849037 | |
| Mean :34543030 | |
| 3rd Qu.:38444310 | |
| Max. :45873850 | |
| NA’s :2 |
p <- ggplot(world_dev_ind_spread %>% mutate(Year=strtoi(Year)), aes(Year, EN.ATM.GHGT.KT.CE)) +
ggtitle("Total greenhouse gas emissions (World)") +
ylab("Gas emission [kt of CO2 equivalent]") +
geom_line()
ggplotly(p)
Spośród wskaźników światowego rozwoju najwyższą wartość korelacji z cenami złota osiągneła całkowita emisja gazów cieplarnianych. Na powyższym wykresie podobnie jak w przypadku cen złota widać tendencję wzrostową tej wartości w ostatnich latach. Jedyny znaczący jej spadek miał miejsce między rokiem 1989 a 1990.
print(knitr::kable(summary(curr_ex_rates[, "Brunei.Dollar", drop=FALSE])))
| Brunei.Dollar | |
|---|---|
| Min. :1.000 | |
| 1st Qu.:1.348 | |
| Median :1.468 | |
| Mean :1.508 | |
| 3rd Qu.:1.698 | |
| Max. :1.851 | |
| NA’s :1246 |
p <- ggplot(curr_ex_rates, aes(Date, Brunei.Dollar)) +
ggtitle("Brunei Dollar's Exchange Rate") +
ylab("Exchange Rate") +
xlim(as.Date("1968-01-01"), as.Date("2021-12-31")) +
geom_line()
ggplotly(p)
Wartość współczynnika korelacji między kursem dolara brunejskiego a ceną złota wyniosła -0.96. Tą silną ujemną korelację potwierdza powyższy wykres, na którym widać tendencję spadkową kursu tej waluty w ostatnich latach, czyli przeciwną niż w przypadku cen złota. Ostatnie większe wzrosty tej wartości miały miejsce między rokiem 2008 a 2009 i między 2014 a 2016. Swoją maksymalną wartość 1,851 osiągnęła ona 31.12.2001. Natomiast wartość minimalną równą 1 osiągnęła 02.09.1998, jednak jak pokazuje wykres jest to wartość odstająca, więc prawdopodobnie jest niepoprawna. Wartość minimalną pasującą do trendu pokazywanego przez wykres widać 27.07.2011 i wynosi ona 1,2.
Poniższy wykres przedstawia zależność ceny złota od kursu dolara brunejskiego, która potwierdza ujemną korelację między tymi zmiennymi.
p <- ggplot(gold_and_curr, aes(Brunei.Dollar, Price_USD_AM)) +
ggtitle("Dependency between Gold Price and Brunei Dollar Exchange Rate") +
ylab("Gold Price") +
xlab("Brunei Dollar Exchange Rate") +
geom_point()
ggplotly(p)
print(knitr::kable(summary(sp_composite[, "Dividend", drop=FALSE])))
| Dividend | |
|---|---|
| Min. : 2.930 | |
| 1st Qu.: 6.362 | |
| Median :12.967 | |
| Mean :17.622 | |
| 3rd Qu.:23.715 | |
| Max. :59.680 | |
| NA’s :4 |
p <- ggplot(sp_composite %>% mutate(Month = as.Date(paste(Month, "-01", sep=""))), aes(Month, Dividend)) +
ggtitle("Dividend") +
xlim(as.Date("1968-01-01"), as.Date("2021-12-31")) +
geom_line()
ggplotly(p)
Najwyższą korelację z cenami złota ze zbioru S&P Composite wykazuje dywidenda, której wartości w ostatnich latach wykazują wyraźną tendencję wzrostową od wartości 2,93 do 59,68.
W sekcji tej stworzono regresor przewidujący ceny złota na podstawie zmiennych, których wartość bezwzględna współczynnika korelacji wyniosła co najmniej 0,85.
Ze zbiorów danych wybrano najbardziej skorelowane zmienne, które połączono razem z cenami złota w jeden zbiór w zmiennej dataset. Aby wśród przypadków treningowych i testowych nie było krotek, w których brakuje wartości którejś zmiennej, krótsze przerwy w danych (do 5 wartości NA pod rząd) wypełniono za pomocą interpolacji liniowej, natomiast wiersze które po tym zabiegu nadal zawierały wartości puste usunięto.
wdi_correlated <- world_dev_ind_spread %>% select(Year, gold_wdi_most_correlated)
curr_correlated <- curr_ex_rates %>% select(Date, gold_curr_most_correlated)
sp_correlated <- sp_composite %>% select(Month, gold_sp_most_correlated)
dataset <- gold_prices %>%
full_join(wdi_correlated, by="Year") %>%
full_join(curr_correlated, by="Date") %>%
full_join(sp_correlated, by="Month") %>%
arrange(Date) %>%
mutate(across(-c("Date", "Year", "Month"), ~ na.approx(.x, maxgap=5, rule=2))) %>%
drop_na() %>%
select(-c("Date", "Year", "Month"))
Zbiór danych podzielono na zbiór testowy i treningowy w proporcjach 70%-30%. W procesie uczenia wykorzystana zostanie 3-krotna walidacja krzyżowa powtórzona 5 razy.
set.seed(12321)
inTraining <- createDataPartition(dataset$Price_USD_AM, p=0.7, list=F)
training <- dataset[ inTraining,]
testing <- dataset[-inTraining,]
ctrl <- trainControl(
method = "repeatedcv",
number = 3,
repeats = 5)
Jako algorytm wybrano Random Forest.
set.seed(12321)
fit <- train(Price_USD_AM ~ .,
data = training,
method = "rf",
trControl = ctrl,
ntree = 10)
fit
## Random Forest
##
## 2908 samples
## 25 predictor
##
## No pre-processing
## Resampling: Cross-Validated (3 fold, repeated 5 times)
## Summary of sample sizes: 1939, 1940, 1937, 1939, 1938, 1939, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 2 39.75367 0.9931924 26.30605
## 13 16.79181 0.9987855 10.24495
## 25 18.04737 0.9985890 10.44097
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 13.
Poniższy kod dokonuje oceny jakości predykcji na podstawie zbioru testowego.
test_predictions <- predict(fit, newdata = testing)
postResample(pred = test_predictions, obs = testing$Price_USD_AM)
## RMSE Rsquared MAE
## 14.9532186 0.9990274 8.9470331
Do oceny wykorzystano miary RMSE, Rsquared i MAE, ponieważ są to miary odpowiednie do oceny regresji. Patrząc na wartość RMSE można stwierdzić, że przewidywania ceny złota różniły się średnio o 14,95 od ceny rzeczywistej. Biorąc pod uwagę, że średnia wartość ceny złota wynosiła 575,20, jest to błąd około 2,6%. Jeśli natomiast błąd ten porównamy z medianą ceny złota (383,32) otrzymamy wartość 3,9%. Miara MAE jest około 1,7 razy niższa niż RMSE, co świadczy o występowaniu dużych wartości błędów, które zawyżają RMSE. Miara Rsquared przekraczająca 0,999 świadczy o wysokim stopniu dopasowania modelu do danych.
variable_importance <- varImp(fit)
plot(variable_importance, main="Variable importance in the trained model")
Powyższy wykres pokazuje, że największy wpływ na predykcję ma kurs chińskiego yuana. Natomiast kurs dolara brunejskiego, analizowanego wcześniej jako kurs o największym współczynniku korelacji, znalazł się dopiero na 8 miejscu. Poniżej przedstawiono wykres zależności między kursem tej waluty a ceną złota, analogicznie jak wcześniej dla dolara brunejskiego. Porównując go z wykresem dla dolara widać, że dla danego kursu jest mniej odpowiadających mu cen złota szczególnie dla większych wartości kursu, co pozwala na trafniejsze predykcje.
p <- ggplot(gold_and_curr, aes(Chinese.Yuan, Price_USD_AM)) +
ggtitle("Dependency between Gold Price and Chinese Yuan Exchange Rate") +
ylab("Gold Price") +
xlab("Chinese Yuan Exchange Rate") +
geom_point()
ggplotly(p)
Spośród wskaźników światowego rozwoju analizowana wcześniej emisja gazów cieplarnianych okazała się być trzecim najważniejszym atrybutem. Na drugim miejscu natomiast znalazły się wydatki krajowe brutto, a na czwartym produkcja energii elektrycznej ze źródeł odnawialnych z wyłączeniem hydroelektrowni.